<%
Class FastAsp_Markdown
    Private m_Text       '原始文本
    Private m_Html       'HTML输出
    Private m_Toc        '目录数据
    Private m_TocLevel   '目录层级
    
    Private Sub Class_Initialize()
        m_TocLevel = 3 '默认生成3级目录
        Set m_Toc = Server.CreateObject("Scripting.Dictionary")
    End Sub
    
    '设置文本
    Public Function SetText(byval text)
        m_Text = text
        Set SetText = Me
    End Function
    
    '设置目录层级
    Public Function SetTocLevel(byval level)
        m_TocLevel = level
        Set SetTocLevel = Me
    End Function
    
    '解析Markdown
    Public Function Parse()
        If m_Text = "" Then
            m_Html = ""
            Exit Function
        End If
        
        '预处理
        m_Text = Replace(m_Text, vbCrLf, vbLf)
        m_Text = Replace(m_Text, vbCr, vbLf)
        
        '解析区块
        ParseBlocks()
        
        '解析行内元素
        ParseInline()
        
        '生成目录
        GenerateToc()
        
        Parse = m_Html
    End Function
    
    '获取HTML
    Public Function GetHtml()
        GetHtml = m_Html
    End Function
    
    '获取目录
    Public Function GetToc()
        Set GetToc = m_Toc
    End Function
    
    '解析区块
    Private Sub ParseBlocks()
        Dim lines : lines = Split(m_Text, vbLf)
        Dim line, i, inCode, inQuote, inList, html
        html = ""
        
        For i = 0 To UBound(lines)
            line = lines(i)
            
            '代码块
            If Left(Trim(line), 3) = "```" Then
                If Not inCode Then
                    inCode = True
                    html = html & "<pre><code class=""" & Mid(Trim(line), 4) & """>"
                Else
                    inCode = False
                    html = html & "</code></pre>" & vbCrLf
                End If
                
            '引用
            ElseIf Left(Trim(line), 1) = ">" And Not inCode Then
                If Not inQuote Then
                    inQuote = True
                    html = html & "<blockquote>"
                End If
                html = html & "<p>" & Mid(Trim(line), 2) & "</p>"
                If i = UBound(lines) Or Left(Trim(lines(i + 1)), 1) <> ">" Then
                    inQuote = False
                    html = html & "</blockquote>" & vbCrLf
                End If
                
            '标题
            ElseIf Left(Trim(line), 1) = "#" And Not inCode Then
                Dim level : level = Len(line) - Len(LTrim(Replace(line, "#", "")))
                If level <= 6 Then
                    Dim title : title = Trim(Mid(Trim(line), level + 1))
                    html = html & "<h" & level & ">" & title & "</h" & level & ">" & vbCrLf
                    '记录目录
                    If level <= m_TocLevel Then
                        Dim id : id = "toc_" & m_Toc.Count
                        m_Toc.Add id, Array(level, title, id)
                    End If
                End If
                
            '分隔线
            ElseIf Trim(line) = "---" And Not inCode Then
                html = html & "<hr>" & vbCrLf
                
            '列表
            ElseIf (Left(Trim(line), 2) = "* " Or Left(Trim(line), 2) = "- " Or IsNumeric(Left(Trim(line), 1))) And Not inCode Then
                If Not inList Then
                    inList = True
                    If IsNumeric(Left(Trim(line), 1)) Then
                        html = html & "<ol>"
                    Else
                        html = html & "<ul>"
                    End If
                End If
                html = html & "<li>" & Mid(Trim(line), InStr(Trim(line), " ") + 1) & "</li>"
                If i = UBound(lines) Or (Left(Trim(lines(i + 1)), 2) <> "* " And Left(Trim(lines(i + 1)), 2) <> "- " And Not IsNumeric(Left(Trim(lines(i + 1)), 1))) Then
                    inList = False
                    If IsNumeric(Left(Trim(line), 1)) Then
                        html = html & "</ol>" & vbCrLf
                    Else
                        html = html & "</ul>" & vbCrLf
                    End If
                End If
                
            '普通段落
            ElseIf Trim(line) <> "" And Not inCode Then
                html = html & "<p>" & line & "</p>" & vbCrLf
                
            '代码块内容
            ElseIf inCode Then
                html = html & Server.HTMLEncode(line) & vbCrLf
            End If
        Next
        
        m_Html = html
    End Sub
    
    '解析行内元素
    Private Sub ParseInline()
        '加粗
        m_Html = RegExpReplace(m_Html, "\*\*(.+?)\*\*", "<strong>$1</strong>")
        m_Html = RegExpReplace(m_Html, "__(.+?)__", "<strong>$1</strong>")
        
        '斜体
        m_Html = RegExpReplace(m_Html, "\*(.+?)\*", "<em>$1</em>")
        m_Html = RegExpReplace(m_Html, "_(.+?)_", "<em>$1</em>")
        
        '删除线
        m_Html = RegExpReplace(m_Html, "~~(.+?)~~", "<del>$1</del>")
        
        '行内代码
        m_Html = RegExpReplace(m_Html, "`(.+?)`", "<code>$1</code>")
        
        '链接
        m_Html = RegExpReplace(m_Html, "\[(.+?)\]\((.+?)\)", "<a href=""$2"">$1</a>")
        
        '图片
        m_Html = RegExpReplace(m_Html, "!\[(.+?)\]\((.+?)\)", "<img src=""$2"" alt=""$1"">")
    End Sub
    
    '生成目录
    Private Sub GenerateToc()
        If m_Toc.Count = 0 Then Exit Sub
        
        Dim toc, i, item, level, title, id, lastLevel, j
        toc = "<div class=""toc"">" & vbCrLf
        toc = toc & "<ul>" & vbCrLf
        lastLevel = 1
        
        For i = 0 To m_Toc.Count - 1
            item = m_Toc(m_Toc.Keys(i))
            level = item(0)
            title = item(1)
            id = item(2)
            
            '处理层级
            If level > lastLevel Then
                For j = 1 To level - lastLevel
                    toc = toc & "<ul>" & vbCrLf
                Next
            ElseIf level < lastLevel Then
                For j = 1 To lastLevel - level
                    toc = toc & "</ul>" & vbCrLf
                Next
            End If
            
            toc = toc & "<li><a href=""#" & id & """>" & title & "</a></li>" & vbCrLf
            lastLevel = level
        Next
        
        '关闭未闭合的标签
        For i = 1 To lastLevel
            toc = toc & "</ul>" & vbCrLf
        Next
        
        toc = toc & "</div>"
        m_Toc.Add "html", toc
    End Sub
    
    '正则替换
    Private Function RegExpReplace(byval text, byval pattern, byval replaceWith)
        Dim reg : Set reg = New RegExp
        reg.Pattern = pattern
        reg.Global = True
        RegExpReplace = reg.Replace(text, replaceWith)
        Set reg = Nothing
    End Function
    
    Private Sub Class_Terminate()
        Set m_Toc = Nothing
    End Sub
End Class
%> 